home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / S / SCOOPS / SEND.S < prev    next >
Encoding:
Text File  |  1993-06-15  |  5.7 KB  |  151 lines
  1. ;* SEND.S
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Scheme code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*            Scoops: SEND and SELF                *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: Amitabh Srivastava        Date: 1986        *
  16. ;* Revision history:                            *
  17. ;* - 16 Jul 87: Lutz Euler                        *
  18. ;*    Das Problem bei der Implementietrung von SEND ist das richtige    *
  19. ;*    Besetzen der fluid-Bindung von SELF. Jede Methode ist der Form    *
  20. ;*        (let ((self (fluid self))) ...)                *
  21. ;*    Durch SEND muss also SELF fluidig an das Objekt gebunden    *
  22. ;*    werden, an das die Nachricht geschickt wird.            *
  23. ;*    Die urspruengliche Version von SEND bzw. SEND-IF-HANDLES hat    *
  24. ;*    dieses nicht richtig implementiert. Daraufhin wurden folgende    *
  25. ;*    Aenderungen vorgenommen:                    *
  26. ;*          - SEND und SEND-IF-HANDLES wurden so geaendert, dass die    *
  27. ;*        Argumente exakt in der Umgebung ausgewertet werden, in    *
  28. ;*        der man es erwartet.                    *
  29. ;*          - Die fluid-Bindung von SELF erfolgt erst nach der    *
  30. ;*        Auswertung der Argumente.                *
  31. ;*    Dadurch wird sichergestellt, dass als Argumente auch SELF und    *
  32. ;*    direkte Aufrufe von Methoden der eigenen Klasse zulaessig sind.    *
  33. ;************************************************************************
  34. ;*    Beispiele:                            *
  35. ;*                                    *
  36. ;*        (send obj msg)                        *
  37. ;*    expandiert zu                            *
  38. ;*        ((lambda ()                        *
  39. ;*           (fluid-let ((self obj))                *
  40. ;*             ((access msg (fluid self))))))            *
  41. ;*                                    *
  42. ;*        (send obj msg arg1 arg2)                *
  43. ;*    expandiert zu                            *
  44. ;*        ((lambda (%%**%%0 %%**%%1)                *
  45. ;*           (fluid-let ((self obj))                *
  46. ;*             ((access msg (fluid self)) %%**%%0 %%**%%1)))    *
  47. ;*         arg1                            *
  48. ;*         arg2)                            *
  49. ;************************************************************************
  50. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  51. ;*                                    *
  52. ;*                    ``In nomine omnipotentii dei''    *
  53. ;************************************************************************
  54. ;*    There are two way to handle SEND. Unfortunately, they have an    *
  55. ;* impact on the user syntax.                        *
  56. ;*                                    *
  57. ;*   1. ``SEND obj msg args'' expands into something like        *
  58. ;*        (fluid-let ((SELF obj))                    *
  59. ;*          ((acess msg obj) args))                *
  60. ;*    Each method expands into a                    *
  61. ;*        (lambda (args)                        *
  62. ;*          (let ((self (fluid self)))                *
  63. ;*            body))                        *
  64. ;*       One does not have to use the SEND form to invoke methods in    *
  65. ;*    the same class. They can be invoked as a Scheme function.    *
  66. ;*       This has the advantage of skipping over the overhead of a    *
  67. ;*    call to send; however, it has the disadvantage that send is no    *
  68. ;*    longer tail recursive.                        *
  69. ;*       The version of SCOOPS for PCS uses this philosophy but by    *
  70. ;*    using some system dependant features we were able to make it    *
  71. ;*    tail recursive.                            *
  72. ;*                                    *
  73. ;*   2. Another way is to have the SEND form pass an extra argument;    *
  74. ;*    for example, ``SEND obj msg args'' is expanded to        *
  75. ;*        ((access msg obj) obj args)                *
  76. ;*    Note: care should be taken so that OBJ not be evaluated more    *
  77. ;*    than once.                            *
  78. ;*       Also, each method expects an extra argument:            *
  79. ;*        (lambda (SELF ,@bvl) body)                *
  80. ;*       With this approach the user has to use the SEND form to call *
  81. ;*    any method (even methods in its class).                *
  82. ;*                                    *
  83. ;*    I have changed the SCOOPS source as per 1 to use the existing    *
  84. ;* SCOOPS syntax. It is a trivial change to make the sources conform    *
  85. ;* to 2.                                *
  86. ;************************************************************************
  87.  
  88. ; send
  89.  
  90. (macro send
  91.   (lambda (e)
  92.     (let ((args (cdddr e))
  93.           (msg (caddr e))
  94.           (obj (cadr e)))
  95. ; Aenderung am 16.07.87 :
  96. ;   Alt:
  97. ;     `(LET ((SELF ,obj))
  98. ;        (FLUID-LET ((SELF SELF))
  99. ;          ((ACCESS ,msg SELF) ,@args)))
  100. ;   Neu:
  101.       (let ((formals
  102.               (let loop ((rest args)
  103.                          (counter 0))
  104.                 (cond ((null? rest)
  105.                        #!null)
  106.                       (else
  107.                         (cons (string->symbol
  108.                                 (string-append
  109.                                   "%%**%%"
  110.                                   (number->string counter '(int))))
  111.                               (loop (cdr rest) (1+ counter))))))))
  112.         `((lambda ,formals
  113.             (fluid-let ((self ,obj))
  114.               ((access ,msg (fluid self)) ,@formals)))
  115.           ,@args)))))
  116.  
  117.  
  118. ; send-if-handles
  119.  
  120. (macro send-if-handles
  121.   (lambda (e)
  122.     (let ((obj (cadr e))
  123.           (msg (caddr e))
  124.           (args (cdddr e)))
  125. ; Aenderung am 16.07.87 :
  126. ;   Alt:
  127. ;     `(LET ((SELF ,obj))
  128. ;        (IF (ASSQ ',msg (%SC-METHOD-STRUCTURE (ACCESS %SC-CLASS SELF)))
  129. ;            (SEND SELF ,msg ,@args)
  130. ;            #F))
  131. ;   Neu:
  132.       (let ((formals
  133.               (let loop ((rest args)
  134.                          (counter 0))
  135.                 (cond ((null? rest)
  136.                        #!null)
  137.                       (else
  138.                         (cons (string->symbol
  139.                                 (string-append
  140.                                   "%%**%%"
  141.                                   (number->string counter '(int))))
  142.                               (loop (cdr rest) (1+ counter))))))))
  143.         `((lambda ,formals
  144.             (fluid-let ((self ,obj))
  145.               (if (assq ',msg (%sc-method-structure
  146.                                 (access %sc-class (fluid self))))
  147.                   ((access ,msg (fluid self)) ,@formals)
  148.                   #F)))
  149.           ,@args)))))
  150.  
  151.